' SoundPlayer
' Plays digitized sounds from snd resources
' and sound data files using
' MicroSoft QuickBasic 1.0
' by Ron Butcher 2/6/89
CLEAR, 100000&
DIM Paramblock%(39),scr%(3),bar%(3),pt%(2),r%(3)
DIM PHS$(200),id%(200)
DIM Reg&(5)
' Trap calls
RITE%=&HA003:Ohpen%=&HA000
Dread%=&HA002:Klose%=&HA001:GetEOF%=&HA011
NewPtr%=&HA01E : DisposePtr%=&HA01F
'Initialize variables and constants
FFsynthPtr&=0:Param&=0:Siz&=0:h&=0:S&=0:ResH&=0
oldbut%=0:butnum%=0:Tag&=0:state%=0
x0%=0:y0%=0:y%=0:x%=0
true%=-1:false%=0:GotPointer%=false%:er%=0
MenuItem%=0:MenuChoice%=0
ForkOpen%=false%:gotresource%=false%
num%=2:num1%=0:ref%=0:id%=0:action%=0
type$="snd ":nam$="":F$="":G$="":pic$=""
lfd&=0:I=0:count&=0:resid%=0
TwentyTwoK&=&H10000& ' count values
ElevenK&=&H8000&
SevenK&=&H5555&
FiveK&=&H4000&
ToolBox "i"
WINDOW CLOSE 1
MENU 1,0,1,"File"
MENU 1,1,1,"Open Sound Data"
MENU 1,2,1,"Open Sound Resource"
MENU 1,3,0,"Draw Sound Graph"
MENU 1,4,1,"Quit"
CmdKey 1,1,"D"
CmdKey 1,2,"R"
CmdKey 1,3,"G"
CmdKey 1,4,"Q"
Sheight=SYSTEM(6)
Swidth=SYSTEM(5)
WINDOW 2,"",(50,100)-(Swidth-32,Sheight-77),3
BUTTON 1,1,"22 KHz",(25,25)-(100,40),3
BUTTON 2,2,"11 KHz",(25,60)-(100,75),3
BUTTON 3,1,"7.4 KHz",(25,95)-(100,110),3
BUTTON 4,1,"5.5 KHz",(25,130)-(100,145),3
BUTTON 5,0,"Play",(130,75)-(190,100)
SetRect scr%(0),200,6,400,158
SetRect bar%(0),399,6,415,158
r%(0)=75
r%(1)=130
r%(2)=100
r%(3)=190
inSetRect r%(0),-4,-4
oldbut%=2:count&=ElevenK&
linenum%=0:top%=0:S&=0:in%=0
NewScroll S&,bar%(0),1,1,1,1
InactiveScroll S&
PICTURE ON
PENSIZE 3,3
FRAMEROUNDRECT VARPTR(r%(0)),16,16
PENNORMAL
ERASERECT VARPTR(scr%(0))
FRAMERECT VARPTR(scr%(0))
PICTURE OFF
pic$=PICTURE$
PICTURE ON : PICTURE OFF
refresh

ON MENU GOSUB MenSelect : MENU ON
ON DIALOG GOSUB ChoiceWait : DIALOG ON

UserWait:
WHILE true%
 hittest
 ScrollText S&,scr%(0),PHS$(1),top%,num1%,linenum%,3
WEND

ChoiceWait:
MENU STOP : MOUSE STOP
action%=DIALOG(0)
IF action%=5 THEN CALL refresh
IF action%<>1 THEN
  MENU ON : MOUSE ON
  RETURN
END IF
ON action% GOSUB HandleButton
MENU ON : MOUSE ON
RETURN

HandleButton:
butnum%=DIALOG(1)
IF butnum%=oldbut% THEN RETURN
IF butnum% <> 5 THEN
  BUTTON butnum%,2
  BUTTON oldbut%,1
  oldbut%=butnum%
END IF
SELECT CASE butnum%
  CASE 1
    count&=TwentyTwoK&
  CASE 2
    count&=ElevenK&
  CASE 3
    count&=SevenK&
  CASE 4
    count&=FiveK&
  CASE 5
    GOSUB writefork
END SELECT
RETURN

openDataFile:
F$=FILES$(1,"FSSD"):IF F$="" THEN RETURN
BUTTON 5,0
gotresource% = false%
IF ForkOpen% THEN
    GOSUB CleanItUp
    ForkOpen%=false%
END IF
PtrTest
GOSUB ReadFork
Tag&=PEEKL(FFsynthPtr&+6) '"HCOM"
IF Tag&=1212370765& THEN BEEP:RETURN 'compressed
BUTTON 5,1
RETURN

openResFile:
F$=FILES$(1,"SFILSTAK"):IF F$="" THEN RETURN
BUTTON 5,0
PtrTest
in%=0:top%=0:linenum%=0:resid%=0
GOSUB CountResources
GOSUB ClearBuffer
RETURN

Quit:
IF ForkOpen% THEN GOSUB CleanItUp
PtrTest
DisposeScroll S&
WINDOW CLOSE 2
END

MenSelect:
MenuItem%=MENU(0)
IF MenuItem% <>1 THEN RETURN
MenuChoice%=MENU(1)
MENU
ON MenuChoice% GOSUB openDataFile,openResFile,Drawgraph,Quit
RETURN

writefork:
IF gotresource% THEN GOSUB LoadResource
POKEW FFsynthPtr&,0 '0 for ffmode
POKEL FFsynthPtr&+2,count& 'sizing value
Param&=VARPTR(Paramblock%(0))
POKE Param&+27,0       'reset permission
POKEW Param&+24,&HFFFC 'Sound Driver refnum
POKEL Param&+36,lfd&   'length to write
POKEW Param&+44,0      'ioPosMode
POKEL Param&+46,0      'ioPosOffSet
POKEL Param&+32,FFsynthPtr& 'address of synthrec
ToolBox "R",RITE%,Reg&(0),(Param&) ' call _Write
RETURN

ReadFork:
GOSUB ClearBuffer
B2PStr F$,G$
Param&=VARPTR(Paramblock%(0))
POKEL Param&+18,SADD(G$) 'address of filename
POKE Param&+27,1         'read only
ToolBox "R",Ohpen%,Reg&(0),(Param&)  'call _Open
ToolBox "R",GetEOF%,Reg&(0),(Param&) 'call _GetEOF
Param&=VARPTR(Paramblock%(0))
lfd&=PEEKL(Param&+28) 'file length
IF lfd& =0 THEN       'No data
  ToolBox "R",Klose%,Reg&(0),(Param&)
  BEEP : RETURN
END IF
Siz&=lfd&+6              '6 bytes for mode and count
GOSUB GetPointer
Param&=VARPTR(Paramblock%(0))
POKEL Param&+36,lfd&        'number of bytes to read
POKEL Param&+32,FFsynthPtr&+6 'block address
POKEW Param&+44,1 'ioPosMode read from start of file 
ToolBox "R",Dread%,Reg&(0),(Param&) 'call _Read
ToolBox "R",Klose%,Reg&(0),(Param&) 'call _Close
RETURN

GetPointer:
'Get block of Siz& bytes and
'return address in FFsynthPtr&
ToolBox "R",NewPtr%,Reg&(0),,,(Siz&) 'call _NewPointer
GotPointer%=true%
FFsynthPtr&=Reg&(0)
RETURN

LoadResource:
IF resid%=id%(linenum%) THEN RETURN
PtrTest
'Get the resource
GetRes ref%,type$,id%(linenum%),h&
resid%=id%(linenum%)
HLock h&
GetHandleSize h&,lfd&
Siz&=lfd&
GOSUB GetPointer
'coerce pointer
ResH&=PEEKL(h&)
BlockMove ResH&,FFsynthPtr&,Siz&
Hunlock h&
ReleaseRes h&
RETURN

CountResources:
IF ForkOpen% THEN GOSUB CleanItUp:ForkOpen%=false%
PtrTest
CountRes type$,num%        'number in System
ToolBox "WQ",&H997,F$,ref% 'openresfile
ForkOpen%=true%
updateresfile ref%
CountRes type$,num1%
num1%=num1%-num%           'number of type snd     
GOSUB GetResources
RETURN

GetResources:
'set ResLoad to false
POKEW &HA5E,0 'comment out for interpreter
FOR ind%=1 TO num1%
  GetIndRes type$,ind%,h&
  GetResInfo h&,id%(ind%),type$,nam$
  ReleaseRes h&
  PHS$(ind%)=nam$+" - "+STR$(id%(ind%))
  NEXT ind%
'set ResLoad to true
POKEW &HA5E,-1 'comment out for interpreter
gotresource%=true%
ActiveScroll S&
RETURN

ClearBuffer:
Param&=VARPTR(Paramblock%(0))
FOR I=0 TO 79: POKE Param&+I,0: NEXT I
RETURN

CleanItUp:
CloseResfile ref%
InactiveScroll S&
in%=0:top%=0:linenum%=0:resid%=0:num1%=0
RETURN

Drawgraph:
DIALOG STOP :MENU OFF
WINDOW 3,"",(0,20)-(Swidth,Sheight),3
MOVETO 0,0
inc=lfd&\Swidth
x0%=0:y0%=0:y%=0:x%=0
FOR I=1 TO lfd& STEP inc
  LINETO x0%,y%
  y%=PEEK(FFsynthPtr&+(I))
  y%=(128-y%)+128 'Invert it
  PSET (x%,y%)
  x0%=x%
  x%=x%+1
NEXT I
TEXTFONT 0
MOVETO 180,300
DrawText "Click Mouse to Continue"
TEXTFONT 1
WHILE MOUSE(0)=0:WEND
WINDOW CLOSE 3
WINDOW 2
DIALOG ON:MENU ON
RETURN

SUB hittest STATIC
SHARED scr%(),pt%(),num1%,linenum%,gotresource%
in%=0
IF NOT gotresource% THEN EXIT SUB
IF MOUSE(0)=1 THEN
  GetMouse pt%(1)
  PtInRect pt%(1),scr%(0),in%
    IF in% THEN
      found
    END IF
    IF linenum%<>0 AND linenum%<=num1% THEN
      state%=1 
    ELSE
      state%=0
    END IF
  BUTTON 5,state%
  refresh
END IF
END SUB

SUB found STATIC
SHARED linenum%,num1%,top%,pt%(),scr%()
 linenum%=top%+(pt%(1)-scr%(0))\20
END SUB

SUB refresh STATIC
SHARED scr%(),PHS$(),S&,num1%,linenum%,pic$
PICTURE,pic$
top%=0
ScrollText S&,scr%(0),PHS$(1),top%,num1%,linenum%,3
END SUB

SUB PtrTest STATIC
SHARED GotPointer%,Reg&(),FFsynthPtr&
DisposePtr%=&HA01F
IF GotPointer% THEN  'call _DisposePointer
  CALL ToolBox("R",DisposePtr%,Reg&(0),(FFsynthPtr&))
  GotPointer%=0
END IF
END SUB